home *** CD-ROM | disk | FTP | other *** search
/ Ultra Pack / UltraComputing Partner Applications.iso / SunLabs / tclTK / src / tk4.0 / tests / listbox.test < prev    next >
Encoding:
Text File  |  1995-06-25  |  43.7 KB  |  1,404 lines
  1. # This file is a Tcl script to test out the "listbox" command
  2. # of Tk.  It is organized in the standard fashion for Tcl tests.
  3. #
  4. # Copyright (c) 1993-1994 The Regents of the University of California.
  5. # Copyright (c) 1994-1995 Sun Microsystems, Inc.
  6. #
  7. # See the file "license.terms" for information on usage and redistribution
  8. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  9. #
  10. # @(#) listbox.test 1.27 95/06/24 17:07:00
  11.  
  12. if {[string compare test [info procs test]] == 1} then \
  13.   {source defs}
  14.  
  15. foreach i [winfo children .] {
  16.     destroy $i
  17. }
  18. wm geometry . {}
  19. raise .
  20. set fixed -adobe-courier-medium-r-normal--12-120-75-75-m-*-iso8859-1
  21.  
  22. proc record args {
  23.     global log
  24.     lappend log $args
  25. }
  26.  
  27. proc getsize w {
  28.     regexp {(^[^+-]*)} [wm geometry $w] foo x
  29.     return $x
  30. }
  31.  
  32. proc resetGridInfo {} {
  33.     # Some window managers, such as mwm, don't reset gridding information
  34.     # unless the window is withdrawn and re-mapped.  If this procedure
  35.     # isn't invoked, the window manager will stay in gridded mode, which
  36.     # can cause all sorts of problems.  The "wm positionfrom" command is
  37.     # needed so that the window manager doesn't ask the user to
  38.     # manually position the window when it is re-mapped.
  39.  
  40.     wm withdraw .
  41.     wm positionfrom . user
  42.     wm deiconify .
  43. }
  44.  
  45. # Procedure that creates a second listbox for checking things related
  46. # to partially visible lines.
  47.  
  48. proc mkPartial {{w .partial}} {
  49.     catch {destroy $w}
  50.     toplevel $w
  51.     wm geometry $w +0+0
  52.     listbox $w.l -width 30 -height 5
  53.     pack $w.l -expand 1 -fill both
  54.     $w.l insert end one two three four five six seven eight nine ten \
  55.         eleven twelve thirteen fourteen fifteen
  56.     update
  57.     scan [wm geometry $w] "%dx%d" width height
  58.     wm geometry $w ${width}x[expr $height-3]
  59.     update
  60. }
  61.  
  62. listbox .l
  63. pack .l
  64. update
  65. resetGridInfo
  66. set i 1
  67.  
  68. foreach test {
  69.     {-background #ff0000 #ff0000 non-existent
  70.         {unknown color name "non-existent"}}
  71.     {-bd 4 4 badValue {bad screen distance "badValue"}}
  72.     {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}}
  73.     {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
  74.     {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
  75.     {-exportselection yes 1 xyzzy {expected boolean value but got "xyzzy"}}
  76.     {-fg #110022 #110022 bogus {unknown color name "bogus"}}
  77.     {-font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* 
  78.         -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* bogus
  79.         {font "bogus" doesn't exist}}
  80.     {-foreground #110022 #110022 bogus {unknown color name "bogus"}}
  81.     {-height 30 30 20p {expected integer but got "20p"}}
  82.     {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}}
  83.     {-highlightcolor #123456 #123456 bogus {unknown color name "bogus"}}
  84.     {-highlightthickness 6 6 bogus {bad screen distance "bogus"}}
  85.     {-highlightthickness -2 0 {} {}}
  86.     {-relief groove groove 1.5 {bad relief type "1.5":  must be flat, groove, raised, ridge, or sunken}}
  87.     {-selectbackground #110022 #110022 bogus {unknown color name "bogus"}}
  88.     {-selectborderwidth 1.3 1 badValue {bad screen distance "badValue"}}
  89.     {-selectforeground #654321 #654321 bogus {unknown color name "bogus"}}
  90.     {-selectmode string string {} {}}
  91.     {-setgrid false 0 lousy {expected boolean value but got "lousy"}}
  92.     {-takefocus "any string" "any string" {} {}}
  93.     {-width 45 45 3p {expected integer but got "3p"}}
  94.     {-xscrollcommand {Some command} {Some command} {} {}}
  95.     {-yscrollcommand {Another command} {Another command} {} {}}
  96. } {
  97.     set name [lindex $test 0]
  98.     test listbox-1.$i {configuration options} {
  99.     .l configure $name [lindex $test 1]
  100.     list [lindex [.l configure $name] 4] [.l cget $name]
  101.     } [list [lindex $test 2] [lindex $test 2]]
  102.     incr i
  103.     if {[lindex $test 3] != ""} {
  104.     test listbox-1.$i {configuration options} {
  105.         list [catch {.l configure $name [lindex $test 3]} msg] $msg
  106.     } [list 1 [lindex $test 4]]
  107.     }
  108.     .l configure $name [lindex [.l configure $name] 3]
  109.     incr i
  110. }
  111.  
  112. test listbox-2.1 {Tk_ListboxCmd procedure} {
  113.     list [catch {listbox} msg] $msg
  114. } {1 {wrong # args: should be "listbox pathName ?options?"}}
  115. test listbox-2.2 {Tk_ListboxCmd procedure} {
  116.     list [catch {listbox gorp} msg] $msg
  117. } {1 {bad window path name "gorp"}}
  118. test listbox-2.3 {Tk_ListboxCmd procedure} {
  119.     catch {destroy .l}
  120.     listbox .l
  121.     list [winfo exists .l] [winfo class .l] [info commands .l]
  122. } {1 Listbox .l}
  123. test listbox-2.4 {Tk_ListboxCmd procedure} {
  124.     catch {destroy .l}
  125.     list [catch {listbox .l -gorp foo} msg] $msg [winfo exists .l] \
  126.         [info commands .l]
  127. } {1 {unknown option "-gorp"} 0 {}}
  128. test listbox-2.5 {Tk_ListboxCmd procedure} {
  129.     catch {destroy .l}
  130.     listbox .l
  131. } {.l}
  132.  
  133. catch {destroy .l}
  134. listbox .l -width 20 -height 5 -bd 4 -highlightthickness 1 -selectborderwidth 2
  135. pack .l
  136. .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 el12 el13 el14 \
  137.     el15 el16 el17
  138. update
  139. test listbox-3.1 {ListboxWidgetCmd procedure} {
  140.     list [catch .l msg] $msg
  141. } {1 {wrong # args: should be ".l option ?arg arg ...?"}}
  142. test listbox-3.2 {ListboxWidgetCmd procedure, "activate" option} {
  143.     list [catch {.l activate} msg] $msg
  144. } {1 {wrong # args: should be ".l activate index"}}
  145. test listbox-3.3 {ListboxWidgetCmd procedure, "activate" option} {
  146.     list [catch {.l activate a b} msg] $msg
  147. } {1 {wrong # args: should be ".l activate index"}}
  148. test listbox-3.4 {ListboxWidgetCmd procedure, "activate" option} {
  149.     list [catch {.l activate fooey} msg] $msg
  150. } {1 {bad listbox index "fooey":  must be active, anchor, end, @x,y, or a number}}
  151. test listbox-3.5 {ListboxWidgetCmd procedure, "activate" option} {
  152.     .l activate 3
  153.     .l index active
  154. } 3
  155. test listbox-3.6 {ListboxWidgetCmd procedure, "bbox" option} {
  156.     list [catch {.l bbox} msg] $msg
  157. } {1 {wrong # args: should be ".l bbox index"}}
  158. test listbox-3.7 {ListboxWidgetCmd procedure, "bbox" option} {
  159.     list [catch {.l bbox a b} msg] $msg
  160. } {1 {wrong # args: should be ".l bbox index"}}
  161. test listbox-3.8 {ListboxWidgetCmd procedure, "bbox" option} {
  162.     list [catch {.l bbox fooey} msg] $msg
  163. } {1 {bad listbox index "fooey":  must be active, anchor, end, @x,y, or a number}}
  164. test listbox-3.9 {ListboxWidgetCmd procedure, "bbox" option} {
  165.     .l yview 3
  166.     update
  167.     list [.l bbox 2] [.l bbox 8]
  168. } {{} {}}
  169. if $doNonPortableTests {
  170.     # These tests are non-portable due to variations in font sizes.
  171.  
  172.     test listbox-3.10 {ListboxWidgetCmd procedure, "bbox" option} {
  173.     .l yview 3
  174.     update
  175.     list [.l bbox 3] [.l bbox 4]
  176.     } {{5 7 16 15} {5 27 17 15}}
  177.     test listbox-3.11 {ListboxWidgetCmd procedure, "bbox" option} {
  178.     catch {destroy .t}
  179.     toplevel .t
  180.     wm geom .t +0+0
  181.     listbox .t.l -width 10 -height 5
  182.     .t.l insert 0 "Short" "Somewhat longer" "Really, quite a whole lot longer than can possibly fit on the screen" "Short"
  183.     pack .t.l
  184.     update
  185.     .t.l xview moveto .2
  186.     .t.l bbox 2
  187.     } {-66 41 369 15}
  188.     test listbox-3.12 {ListboxWidgetCmd procedure, "bbox" option, partial last line} {
  189.     mkPartial
  190.     list [.partial.l bbox 3] [.partial.l bbox 4]
  191.     } {{4 59 23 15} {4 77 20 15}}
  192. }
  193. test listbox-3.13 {ListboxWidgetCmd procedure, "cget" option} {
  194.     list [catch {.l cget} msg] $msg
  195. } {1 {wrong # args: should be ".l cget option"}}
  196. test listbox-3.14 {ListboxWidgetCmd procedure, "cget" option} {
  197.     list [catch {.l cget a b} msg] $msg
  198. } {1 {wrong # args: should be ".l cget option"}}
  199. test listbox-3.15 {ListboxWidgetCmd procedure, "cget" option} {
  200.     list [catch {.l cget -gorp} msg] $msg
  201. } {1 {unknown option "-gorp"}}
  202. test listbox-3.16 {ListboxWidgetCmd procedure, "cget" option} {
  203.     .l cget -setgrid
  204. } {0}
  205. test listbox-3.17 {ListboxWidgetCmd procedure, "configure" option} {
  206.     llength [.l configure]
  207. } {23}
  208. test listbox-3.18 {ListboxWidgetCmd procedure, "configure" option} {
  209.     list [catch {.l configure -gorp} msg] $msg
  210. } {1 {unknown option "-gorp"}}
  211. test listbox-3.19 {ListboxWidgetCmd procedure, "configure" option} {
  212.     .l configure -setgrid
  213. } {-setgrid setGrid SetGrid 0 0}
  214. test listbox-3.20 {ListboxWidgetCmd procedure, "configure" option} {
  215.     list [catch {.l configure -gorp is_messy} msg] $msg
  216. } {1 {unknown option "-gorp"}}
  217. test listbox-3.21 {ListboxWidgetCmd procedure, "configure" option} {
  218.     set oldbd [.l cget -bd]
  219.     set oldht [.l cget -highlightthickness]
  220.     .l configure -bd 3 -highlightthickness 0
  221.     set x "[.l cget -bd] [.l cget -highlightthickness]"
  222.     .l configure -bd $oldbd -highlightthickness $oldht
  223.     set x
  224. } {3 0}
  225. test listbox-3.22 {ListboxWidgetCmd procedure, "curselection" option} {
  226.     list [catch {.l curselection a} msg] $msg
  227. } {1 {wrong # args: should be ".l curselection"}}
  228. test listbox-3.23 {ListboxWidgetCmd procedure, "curselection" option} {
  229.     .l selection clear 0 end
  230.     .l selection set 3 6
  231.     .l selection set 9
  232.     .l curselection
  233. } {3 4 5 6 9}
  234. test listbox-3.24 {ListboxWidgetCmd procedure, "delete" option} {
  235.     list [catch {.l delete} msg] $msg
  236. } {1 {wrong # args: should be ".l delete firstIndex ?lastIndex?"}}
  237. test listbox-3.25 {ListboxWidgetCmd procedure, "delete" option} {
  238.     list [catch {.l delete a b c} msg] $msg
  239. } {1 {wrong # args: should be ".l delete firstIndex ?lastIndex?"}}
  240. test listbox-3.26 {ListboxWidgetCmd procedure, "delete" option} {
  241.     list [catch {.l delete badIndex} msg] $msg
  242. } {1 {bad listbox index "badIndex":  must be active, anchor, end, @x,y, or a number}}
  243. test listbox-3.27 {ListboxWidgetCmd procedure, "delete" option} {
  244.     list [catch {.l delete 2 123ab} msg] $msg
  245. } {1 {bad listbox index "123ab":  must be active, anchor, end, @x,y, or a number}}
  246. test listbox-3.28 {ListboxWidgetCmd procedure, "delete" option} {
  247.     catch {destroy .l2}
  248.     listbox .l2
  249.     .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
  250.     .l2 delete 3
  251.     list [.l2 get 2] [.l2 get 3] [.l2 index end]
  252. } {el2 el4 7}
  253. test listbox-3.29 {ListboxWidgetCmd procedure, "delete" option} {
  254.     catch {destroy .l2}
  255.     listbox .l2
  256.     .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
  257.     .l2 delete 2 4
  258.     list [.l2 get 1] [.l2 get 2] [.l2 index end]
  259. } {el1 el5 5}
  260. test listbox-3.30 {ListboxWidgetCmd procedure, "get" option} {
  261.     list [catch {.l get} msg] $msg
  262. } {1 {wrong # args: should be ".l get first ?last?"}}
  263. test listbox-3.31 {ListboxWidgetCmd procedure, "get" option} {
  264.     list [catch {.l get a b c} msg] $msg
  265. } {1 {wrong # args: should be ".l get first ?last?"}}
  266. test listbox-3.32 {ListboxWidgetCmd procedure, "get" option} {
  267.     list [catch {.l get 2.4} msg] $msg
  268. } {1 {bad listbox index "2.4":  must be active, anchor, end, @x,y, or a number}}
  269. test listbox-3.33 {ListboxWidgetCmd procedure, "get" option} {
  270.     list [catch {.l get end bogus} msg] $msg
  271. } {1 {bad listbox index "bogus":  must be active, anchor, end, @x,y, or a number}}
  272. test listbox-3.34 {ListboxWidgetCmd procedure, "get" option} {
  273.     catch {destroy .l2}
  274.     listbox .l2
  275.     .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
  276.     list [.l2 get 0] [.l2 get 3] [.l2 get end]
  277. } {el0 el3 el7}
  278. test listbox-3.35 {ListboxWidgetCmd procedure, "get" option} {
  279.     catch {destroy .l2}
  280.     listbox .l2
  281.     list [.l2 get 0] [.l2 get end]
  282. } {{} {}}
  283. test listbox-3.36 {ListboxWidgetCmd procedure, "get" option} {
  284.     catch {destroy .l2}
  285.     listbox .l2
  286.     .l2 insert 0 el0 el1 el2 "two words" el4 el5 el6 el7
  287.     .l2 get 3 end
  288. } {{two words} el4 el5 el6 el7}
  289. test listbox-3.37 {ListboxWidgetCmd procedure, "index" option} {
  290.     list [catch {.l index} msg] $msg
  291. } {1 {wrong # args: should be ".l index index"}}
  292. test listbox-3.38 {ListboxWidgetCmd procedure, "index" option} {
  293.     list [catch {.l index a b} msg] $msg
  294. } {1 {wrong # args: should be ".l index index"}}
  295. test listbox-3.39 {ListboxWidgetCmd procedure, "index" option} {
  296.     list [catch {.l index @} msg] $msg
  297. } {1 {bad listbox index "@":  must be active, anchor, end, @x,y, or a number}}
  298. test listbox-3.40 {ListboxWidgetCmd procedure, "index" option} {
  299.     .l index 2
  300. } 2
  301. test listbox-3.41 {ListboxWidgetCmd procedure, "insert" option} {
  302.     list [catch {.l insert} msg] $msg
  303. } {1 {wrong # args: should be ".l insert index ?element element ...?"}}
  304. test listbox-3.42 {ListboxWidgetCmd procedure, "insert" option} {
  305.     list [catch {.l insert badIndex} msg] $msg
  306. } {1 {bad listbox index "badIndex":  must be active, anchor, end, @x,y, or a number}}
  307. test listbox-3.43 {ListboxWidgetCmd procedure, "insert" option} {
  308.     catch {destroy .l2}
  309.     listbox .l2
  310.     .l2 insert end a b c d e
  311.     .l2 insert 3 x y z
  312.     .l2 get 0 end
  313. } {a b c x y z d e}
  314. test listbox-3.44 {ListboxWidgetCmd procedure, "nearest" option} {
  315.     list [catch {.l nearest} msg] $msg
  316. } {1 {wrong # args: should be ".l nearest y"}}
  317. test listbox-3.45 {ListboxWidgetCmd procedure, "nearest" option} {
  318.     list [catch {.l nearest a b} msg] $msg
  319. } {1 {wrong # args: should be ".l nearest y"}}
  320. test listbox-3.46 {ListboxWidgetCmd procedure, "nearest" option} {
  321.     list [catch {.l nearest 20p} msg] $msg
  322. } {1 {expected integer but got "20p"}}
  323. test listbox-3.47 {ListboxWidgetCmd procedure, "nearest" option} {
  324.     .l nearest 1000
  325. } {7}
  326. test listbox-3.48 {ListboxWidgetCmd procedure, "scan" option} {
  327.     list [catch {.l scan a b} msg] $msg
  328. } {1 {wrong # args: should be ".l scan mark|dragto x y"}}
  329. test listbox-3.49 {ListboxWidgetCmd procedure, "scan" option} {
  330.     list [catch {.l scan a b c d} msg] $msg
  331. } {1 {wrong # args: should be ".l scan mark|dragto x y"}}
  332. test listbox-3.50 {ListboxWidgetCmd procedure, "scan" option} {
  333.     list [catch {.l scan foo bogus 2} msg] $msg
  334. } {1 {expected integer but got "bogus"}}
  335. test listbox-3.51 {ListboxWidgetCmd procedure, "scan" option} {
  336.     list [catch {.l scan foo 2 2.3} msg] $msg
  337. } {1 {expected integer but got "2.3"}}
  338. if $doNonPortableTests {
  339.     test listbox-3.52 {ListboxWidgetCmd procedure, "scan" option} {
  340.     catch {destroy .t}
  341.     toplevel .t
  342.     wm geom .t +0+0
  343.     listbox .t.l -width 10 -height 5
  344.     .t.l insert 0 "Short" "Somewhat longer" "Really, quite a whole lot longer than can possibly fit on the screen" "Short" a b c d e f g h i j
  345.     pack .t.l
  346.     update
  347.     .t.l scan mark 100 140
  348.     .t.l scan dragto 90 137
  349.     update
  350.     list [.t.l xview] [.t.l yview]
  351.     } {{0.265583 0.455285} {0.0714286 0.428571}}
  352. }
  353. test listbox-3.53 {ListboxWidgetCmd procedure, "scan" option} {
  354.     list [catch {.l scan foo 2 4} msg] $msg
  355. } {1 {bad scan option "foo":  must be mark or dragto}}
  356. test listbox-3.54 {ListboxWidgetCmd procedure, "see" option} {
  357.     list [catch {.l see} msg] $msg
  358. } {1 {wrong # args: should be ".l see index"}}
  359. test listbox-3.55 {ListboxWidgetCmd procedure, "see" option} {
  360.     list [catch {.l see a b} msg] $msg
  361. } {1 {wrong # args: should be ".l see index"}}
  362. test listbox-3.56 {ListboxWidgetCmd procedure, "see" option} {
  363.     list [catch {.l see gorp} msg] $msg
  364. } {1 {bad listbox index "gorp":  must be active, anchor, end, @x,y, or a number}}
  365. test listbox-3.57 {ListboxWidgetCmd procedure, "see" option} {
  366.     .l yview 7
  367.     .l see 7
  368.     .l index @0,0
  369. } {7}
  370. test listbox-3.58 {ListboxWidgetCmd procedure, "see" option} {
  371.     .l yview 7
  372.     .l see 11
  373.     .l index @0,0
  374. } {7}
  375. test listbox-3.59 {ListboxWidgetCmd procedure, "see" option} {
  376.     .l yview 7
  377.     .l see 6
  378.     .l index @0,0
  379. } {6}
  380. test listbox-3.60 {ListboxWidgetCmd procedure, "see" option} {
  381.     .l yview 7
  382.     .l see 5
  383.     .l index @0,0
  384. } {3}
  385. test listbox-3.61 {ListboxWidgetCmd procedure, "see" option} {
  386.     .l yview 7
  387.     .l see 12
  388.     .l index @0,0
  389. } {8}
  390. test listbox-3.62 {ListboxWidgetCmd procedure, "see" option} {
  391.     .l yview 7
  392.     .l see 13
  393.     .l index @0,0
  394. } {11}
  395. test listbox-3.63 {ListboxWidgetCmd procedure, "see" option, partial last line} {
  396.     mkPartial
  397.     .partial.l see 4
  398.     .partial.l index @0,0
  399. } {1}
  400. test listbox-3.64 {ListboxWidgetCmd procedure, "selection" option} {
  401.     list [catch {.l select a} msg] $msg
  402. } {1 {wrong # args: should be ".l selection option index ?index?"}}
  403. test listbox-3.65 {ListboxWidgetCmd procedure, "selection" option} {
  404.     list [catch {.l select a b c d} msg] $msg
  405. } {1 {wrong # args: should be ".l selection option index ?index?"}}
  406. test listbox-3.66 {ListboxWidgetCmd procedure, "selection" option} {
  407.     list [catch {.l selection a bogus} msg] $msg
  408. } {1 {bad listbox index "bogus":  must be active, anchor, end, @x,y, or a number}}
  409. test listbox-3.67 {ListboxWidgetCmd procedure, "selection" option} {
  410.     list [catch {.l selection a 0 lousy} msg] $msg
  411. } {1 {bad listbox index "lousy":  must be active, anchor, end, @x,y, or a number}}
  412. test listbox-3.68 {ListboxWidgetCmd procedure, "selection" option} {
  413.     list [catch {.l selection anchor 0 0} msg] $msg
  414. } {1 {wrong # args: should be ".l selection anchor index"}}
  415. test listbox-3.69 {ListboxWidgetCmd procedure, "selection" option} {
  416.     list [.l selection anchor 5; .l index anchor] \
  417.         [.l selection anchor 0; .l index anchor]
  418. } {5 0}
  419. test listbox-3.70 {ListboxWidgetCmd procedure, "selection" option} {
  420.     .l selection clear 0 end
  421.     .l selection set 2 8
  422.     .l selection clear 3 4
  423.     .l curselection
  424. } {2 5 6 7 8}
  425. test listbox-3.71 {ListboxWidgetCmd procedure, "selection" option} {
  426.     list [catch {.l selection includes 0 0} msg] $msg
  427. } {1 {wrong # args: should be ".l selection includes index"}}
  428. test listbox-3.72 {ListboxWidgetCmd procedure, "selection" option} {
  429.     .l selection clear 0 end
  430.     .l selection set 2 8
  431.     .l selection clear 4
  432.     list [.l selection includes 3] [.l selection includes 4] \
  433.         [.l selection includes 5]
  434. } {1 0 1}
  435. test listbox-3.73 {ListboxWidgetCmd procedure, "selection" option} {
  436.     catch {destroy .l2}
  437.     listbox .l2
  438.     .l2 selection includes 0
  439. } {0}
  440. test listbox-3.74 {ListboxWidgetCmd procedure, "selection" option} {
  441.     .l selection clear 0 end
  442.     .l selection set 2
  443.     .l selection set 5 7
  444.     .l curselection
  445. } {2 5 6 7}
  446. test listbox-3.75 {ListboxWidgetCmd procedure, "selection" option} {
  447.     list [catch {.l selection badOption 0 0} msg] $msg
  448. } {1 {bad selection option "badOption": must be anchor, clear, includes, or set}}
  449. test listbox-3.76 {ListboxWidgetCmd procedure, "size" option} {
  450.     list [catch {.l size a} msg] $msg
  451. } {1 {wrong # args: should be ".l size"}}
  452. test listbox-3.77 {ListboxWidgetCmd procedure, "size" option} {
  453.     .l size
  454. } {18}
  455. test listbox-3.78 {ListboxWidgetCmd procedure, "xview" option} {
  456.     catch {destroy .l2}
  457.     listbox .l2
  458.     update
  459.     .l2 xview
  460. } {0 1}
  461. test listbox-3.79 {ListboxWidgetCmd procedure, "xview" option} {
  462.     catch {destroy .l}
  463.     listbox .l -width 10 -height 5 -font $fixed
  464.     .l insert 0 a b c d e f g h i j k l m n o p q r s t
  465.     pack .l
  466.     update
  467.     .l xview
  468. } {0 1}
  469. catch {destroy .l}
  470. listbox .l -width 10 -height 5 -font $fixed
  471. .l insert 0 a b c d e f g h i j k l m n o p q r s t
  472. .l insert 1 "0123456789a123456789b123456789c123456789d123456789"
  473. pack .l
  474. update
  475. test listbox-3.80 {ListboxWidgetCmd procedure, "xview" option} {
  476.     .l xview 4
  477.     .l xview
  478. } {0.0804598 0.281609}
  479. test listbox-3.81 {ListboxWidgetCmd procedure, "xview" option} {
  480.     list [catch {.l xview foo} msg] $msg
  481. } {1 {expected integer but got "foo"}}
  482. test listbox-3.82 {ListboxWidgetCmd procedure, "xview" option} {
  483.     list [catch {.l xview zoom a b} msg] $msg
  484. } {1 {unknown option "zoom": must be moveto or scroll}}
  485. test listbox-3.83 {ListboxWidgetCmd procedure, "xview" option} {
  486.     .l xview 0
  487.     .l xview moveto .4
  488.     update
  489.     .l xview
  490. } {0.382184 0.583333}
  491. test listbox-3.84 {ListboxWidgetCmd procedure, "xview" option} {
  492.     .l xview 0
  493.     .l xview scroll 2 units
  494.     update
  495.     .l xview
  496. } {0.0402299 0.241379}
  497. test listbox-3.85 {ListboxWidgetCmd procedure, "xview" option} {
  498.     .l xview 30
  499.     .l xview scroll -1 pages
  500.     update
  501.     .l xview
  502. } {0.442529 0.643678}
  503. test listbox-3.86 {ListboxWidgetCmd procedure, "xview" option} {
  504.     .l configure -width 1
  505.     update
  506.     .l xview 30
  507.     .l xview scroll -4 pages
  508.     update
  509.     .l xview
  510. } {0.522989 0.543103}
  511. test listbox-3.87 {ListboxWidgetCmd procedure, "yview" option} {
  512.     catch {destroy .l}
  513.     listbox .l
  514.     pack  .l
  515.     update
  516.     .l yview
  517. } {0 1}
  518. test listbox-3.88 {ListboxWidgetCmd procedure, "yview" option} {
  519.     catch {destroy .l}
  520.     listbox .l
  521.     .l insert 0 el1
  522.     pack  .l
  523.     update
  524.     .l yview
  525. } {0 1}
  526. catch {destroy .l}
  527. listbox .l -width 10 -height 5 -font $fixed
  528. .l insert 0 a b c d e f g h i j k l m n o p q r s t
  529. pack .l
  530. update
  531. test listbox-3.89 {ListboxWidgetCmd procedure, "yview" option} {
  532.     .l yview 4
  533.     update
  534.     .l yview
  535. } {0.2 0.45}
  536. test listbox-3.90 {ListboxWidgetCmd procedure, "yview" option, partial last line} {
  537.     mkPartial
  538.     .partial.l yview
  539. } {0 0.266667}
  540. test listbox-3.91 {ListboxWidgetCmd procedure, "xview" option} {
  541.     list [catch {.l yview foo} msg] $msg
  542. } {1 {bad listbox index "foo":  must be active, anchor, end, @x,y, or a number}}
  543. test listbox-3.92 {ListboxWidgetCmd procedure, "xview" option} {
  544.     list [catch {.l yview foo a b} msg] $msg
  545. } {1 {unknown option "foo": must be moveto or scroll}}
  546. test listbox-3.93 {ListboxWidgetCmd procedure, "xview" option} {
  547.     .l yview 0
  548.     .l yview moveto .31
  549.     .l yview
  550. } {0.3 0.55}
  551. test listbox-3.94 {ListboxWidgetCmd procedure, "xview" option} {
  552.     .l yview 2
  553.     .l yview scroll 2 pages
  554.     .l yview
  555. } {0.4 0.65}
  556. test listbox-3.95 {ListboxWidgetCmd procedure, "xview" option} {
  557.     .l yview 10
  558.     .l yview scroll -3 units
  559.     .l yview
  560. } {0.35 0.6}
  561. test listbox-3.96 {ListboxWidgetCmd procedure, "xview" option} {
  562.     .l configure -height 2
  563.     update
  564.     .l yview 15
  565.     .l yview scroll -4 pages
  566.     .l yview
  567. } {0.55 0.65}
  568. test listbox-3.97 {ListboxWidgetCmd procedure, "xview" option} {
  569.     list [catch {.l whoknows} msg] $msg
  570. } {1 {bad option "whoknows": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, nearest, scan, see, selection, size, xview, or yview}}
  571. test listbox-3.98 {ListboxWidgetCmd procedure, "xview" option} {
  572.     list [catch {.l c} msg] $msg
  573. } {1 {bad option "c": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, nearest, scan, see, selection, size, xview, or yview}}
  574. test listbox-3.99 {ListboxWidgetCmd procedure, "xview" option} {
  575.     list [catch {.l in} msg] $msg
  576. } {1 {bad option "in": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, nearest, scan, see, selection, size, xview, or yview}}
  577. test listbox-3.100 {ListboxWidgetCmd procedure, "xview" option} {
  578.     list [catch {.l s} msg] $msg
  579. } {1 {bad option "s": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, nearest, scan, see, selection, size, xview, or yview}}
  580. test listbox-3.101 {ListboxWidgetCmd procedure, "xview" option} {
  581.     list [catch {.l se} msg] $msg
  582. } {1 {bad option "se": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, nearest, scan, see, selection, size, xview, or yview}}
  583.  
  584. # No tests for DestroyListbox:  I can't come up with anything to test
  585. # in this procedure.
  586.  
  587. if $doNonPortableTests {
  588.     # This test is non-portable due to variations in font sizes.
  589.  
  590.     test listbox-4.1 {ConfigureListbox procedure} {
  591.     catch {destroy .l}
  592.     listbox .l -setgrid 1 -width 25 -height 15
  593.     pack .l
  594.     update
  595.     set x [getsize .]
  596.     .l configure -setgrid 0
  597.     update
  598.     list $x [getsize .]
  599.     } {25x15 185x278}
  600. }
  601. resetGridInfo
  602. test listbox-4.2 {ConfigureListbox procedure} {
  603.     .l configure -highlightthickness -3
  604.     .l cget -highlightthickness
  605. } {0}
  606. test listbox-4.3 {ConfigureListbox procedure} {
  607.     .l configure -exportselection 0
  608.     .l delete 0 end
  609.     .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8
  610.     .l selection set 3 5
  611.     .l configure -exportselection 1
  612.     selection get
  613. } {el3
  614. el4
  615. el5}
  616. test listbox-4.4 {ConfigureListbox procedure} {
  617.     catch {destroy .e}
  618.     entry .e
  619.     .e insert 0 abc
  620.     .e select from 0
  621.     .e select to 2
  622.     .l configure -exportselection 0
  623.     .l delete 0 end
  624.     .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8
  625.     .l selection set 3 5
  626.     .l selection clear 3 5
  627.     .l configure -exportselection 1
  628.     list [selection own] [selection get]
  629. } {.e ab}
  630. test listbox-4.5 {-exportselection option} {
  631.     selection clear .
  632.     .l configure -exportselection 1
  633.     .l delete 0 end
  634.     .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8
  635.     .l selection set 1 1
  636.     set x {}
  637.     lappend x [catch {selection get} msg] $msg [.l curselection]
  638.     .l config -exportselection 0
  639.     lappend x [catch {selection get} msg] $msg [.l curselection]
  640.     .l selection clear 0 end
  641.     lappend x [catch {selection get} msg] $msg [.l curselection]
  642.     .l selection set 1 3
  643.     lappend x [catch {selection get} msg] $msg [.l curselection]
  644.     .l config -exportselection 1
  645.     lappend x [catch {selection get} msg] $msg [.l curselection]
  646. } {0 el1 1 1 {PRIMARY selection doesn't exist or form "STRING" not defined} 1 1 {PRIMARY selection doesn't exist or form "STRING" not defined} {} 1 {PRIMARY selection doesn't exist or form "STRING" not defined} {1 2 3} 0 {el1
  647. el2
  648. el3} {1 2 3}}
  649. test listbox-4.6 {ConfigureListbox procedure} {
  650.     catch {destroy .l}
  651.  
  652.     # The following code (reset geometry, withdraw, etc.) is necessary
  653.     # to reset the state of some window managers like olvwm under
  654.     # SunOS 4.1.3.
  655.  
  656.     wm geom . 300x300
  657.     update
  658.     wm geom . {}
  659.     wm withdraw .
  660.     listbox .l -font $fixed -width 15 -height 20
  661.     pack .l
  662.     update
  663.     wm deiconify .
  664.     set x [getsize .]
  665.     .l configure -setgrid 1
  666.     update
  667.     list $x [getsize .]
  668. } {115x328 15x20}
  669. test listbox-4.7 {ConfigureListbox procedure} {
  670.     catch {destroy .l}
  671.     wm withdraw .
  672.     listbox .l -font $fixed -width 15 -height 20 -setgrid 1
  673.     wm geom . +0+0
  674.     pack .l
  675.     update
  676.     wm deiconify .
  677.     set result [getsize .]
  678.     wm geom . 13x15
  679.     update
  680.     lappend result [getsize .]
  681.     .l configure -setgrid 1
  682.     update
  683.     lappend result [getsize .]
  684. } {15x20 13x15 13x15}
  685. wm geom . {}
  686. catch {destroy .l}
  687. resetGridInfo
  688. test listbox-4.8 {ConfigureListbox procedure} {
  689.     catch {destroy .l}
  690.     listbox .l -width 15 -height 20 -xscrollcommand "record x" \
  691.         -yscrollcommand "record y"
  692.     pack .l
  693.     update
  694.     .l configure -fg black
  695.     set log {}
  696.     update
  697.     set log
  698. } {{y 0 1} {x 0 1}}
  699.  
  700. # No tests for DisplayListbox:  I don't know how to test this procedure.
  701.  
  702. if $doNonPortableTests {
  703.     # This test is non-portable due to variations in font sizes.
  704.  
  705.     test listbox-5.1 {ListboxComputeGeometry procedure} {
  706.     catch {destroy .l}
  707.     listbox .l -font $fixed -width 15 -height 20
  708.     pack .l
  709.     list [winfo reqwidth .l] [winfo reqheight .l]
  710.     } {115 328}
  711.     test listbox-5.2 {ListboxComputeGeometry procedure} {
  712.     catch {destroy .l}
  713.     listbox .l -font $fixed -width 0 -height 10
  714.     pack .l
  715.     update
  716.     list [winfo reqwidth .l] [winfo reqheight .l]
  717.     } {17 168}
  718.     test listbox-5.3 {ListboxComputeGeometry procedure} {
  719.     catch {destroy .l}
  720.     listbox .l -font $fixed -width 0 -height 10 -bd 3
  721.     .l insert 0 Short "Really much longer" Longer
  722.     pack .l
  723.     update
  724.     list [winfo reqwidth .l] [winfo reqheight .l]
  725.     } {138 170}
  726.     test listbox-5.4 {ListboxComputeGeometry procedure} {
  727.     catch {destroy .l}
  728.     listbox .l -font $fixed -width 10 -height 0
  729.     pack .l
  730.     update
  731.     list [winfo reqwidth .l] [winfo reqheight .l]
  732.     } {80 24}
  733.     test listbox-5.5 {ListboxComputeGeometry procedure} {
  734.     catch {destroy .l}
  735.     listbox .l -font $fixed -width 10 -height 0 -highlightthickness 0
  736.     .l insert 0 Short "Really much longer" Longer
  737.     pack .l
  738.     update
  739.     list [winfo reqwidth .l] [winfo reqheight .l]
  740.     } {76 52}
  741. }
  742.  
  743. catch {destroy .l}
  744. listbox .l -height 2 -xscrollcommand "record x" -yscrollcommand "record y"
  745. pack .l
  746. update
  747. test listbox-6.1 {InsertEls procedure} {
  748.     .l delete 0 end
  749.     .l insert end a b c d
  750.     .l insert 5 x y z
  751.     .l insert 2 A
  752.     .l insert 0 q r s
  753.     .l get 0 end
  754. } {q r s a b A c d x y z}
  755. test listbox-6.2 {InsertEls procedure} {
  756.     .l delete 0 end
  757.     .l insert 0 a b c d e f g h i j
  758.     .l selection anchor 2
  759.     .l insert 2 A B
  760.     .l index anchor
  761. } {4}
  762. test listbox-6.3 {InsertEls procedure} {
  763.     .l delete 0 end
  764.     .l insert 0 a b c d e f g h i j
  765.     .l selection anchor 2
  766.     .l insert 3 A B
  767.     .l index anchor
  768. } {2}
  769. test listbox-6.4 {InsertEls procedure} {
  770.     .l delete 0 end
  771.     .l insert 0 a b c d e f g h i j
  772.     .l yview 3
  773.     update
  774.     .l insert 2 A B
  775.     .l index @0,0
  776. } {5}
  777. test listbox-6.5 {InsertEls procedure} {
  778.     .l delete 0 end
  779.     .l insert 0 a b c d e f g h i j
  780.     .l yview 3
  781.     update
  782.     .l insert 3 A B
  783.     .l index @0,0
  784. } {3}
  785. test listbox-6.6 {InsertEls procedure} {
  786.     .l delete 0 end
  787.     .l insert 0 a b c d e f g h i j
  788.     .l activate 5
  789.     .l insert 5 A B
  790.     .l index active
  791. } {7}
  792. test listbox-6.7 {InsertEls procedure} {
  793.     .l delete 0 end
  794.     .l insert 0 a b c d e f g h i j
  795.     .l activate 5
  796.     .l insert 6 A B
  797.     .l index active
  798. } {5}
  799. test listbox-6.8 {InsertEls procedure} {
  800.     .l delete 0 end
  801.     .l insert 0 a b c
  802.     .l index active
  803. } {2}
  804. test listbox-6.9 {InsertEls procedure} {
  805.     .l delete 0 end
  806.     .l insert 0
  807.     .l index active
  808. } {0}
  809. test listbox-6.10 {InsertEls procedure} {
  810.     .l delete 0 end
  811.     .l insert 0 a b "two words"  c d e f g h i j
  812.     update
  813.     set log {}
  814.     .l insert 0 word
  815.     update
  816.     set log
  817. } {{y 0 0.166667}}
  818. test listbox-6.11 {InsertEls procedure} {
  819.     .l delete 0 end
  820.     .l insert 0 a b "two words"  c d e f g h i j
  821.     update
  822.     set log {}
  823.     .l insert 0 "much longer entry"
  824.     update
  825.     set log
  826. } {{y 0 0.166667} {x 0 1}}
  827. if $doNonPortableTests {
  828.     # This test is non-portable due to variations in font sizes.
  829.  
  830.     test listbox-6.12 {InsertEls procedure} {
  831.     catch {destroy .l2}
  832.     listbox .l2 -width 0 -height 0
  833.     pack .l2 -side top
  834.     .l2 insert 0 a b "two words"  c d
  835.     set x {}
  836.     lappend x [winfo reqwidth .l2] [winfo reqheight .l2]
  837.     .l2 insert 0 "much longer entry"
  838.     lappend x [winfo reqwidth .l2] [winfo reqheight .l2]
  839.     } {73 98 115 116}
  840. }
  841.  
  842. test listbox-7.1 {DeleteEls procedure} {
  843.     .l delete 0 end
  844.     .l insert 0 a b c d e f g h i j
  845.     .l selection set 1 6
  846.     .l delete 4 3
  847.     list [.l size] [selection get]
  848. } {10 {b
  849. c
  850. d
  851. e
  852. f
  853. g}}
  854. test listbox-7.2 {DeleteEls procedure} {
  855.     .l delete 0 end
  856.     .l insert 0 a b c d e f g h i j
  857.     .l selection set 3 6
  858.     .l delete 4 4
  859.     list [.l size] [.l get 4] [.l curselection]
  860. } {9 f {3 4 5}}
  861. test listbox-7.3 {DeleteEls procedure} {
  862.     .l delete 0 end
  863.     .l insert 0 a b c d e f g h i j
  864.     .l delete 0 3
  865.     list [.l size] [.l get 0] [.l get 1]
  866. } {6 e f}
  867. test listbox-7.4 {DeleteEls procedure} {
  868.     .l delete 0 end
  869.     .l insert 0 a b c d e f g h i j
  870.     .l delete 8 1000
  871.     list [.l size] [.l get 7]
  872. } {8 h}
  873. test listbox-7.5 {DeleteEls procedure} {
  874.     .l delete 0 end
  875.     .l insert 0 a b c d e f g h i j
  876.     .l selection anchor 2
  877.     .l delete 0 1
  878.     .l index anchor
  879. } {0}
  880. test listbox-7.6 {DeleteEls procedure} {
  881.     .l delete 0 end
  882.     .l insert 0 a b c d e f g h i j
  883.     .l selection anchor 2
  884.     .l delete 2
  885.     .l index anchor
  886. } {2}
  887. test listbox-7.7 {DeleteEls procedure} {
  888.     .l delete 0 end
  889.     .l insert 0 a b c d e f g h i j
  890.     .l selection anchor 4
  891.     .l delete 2 5
  892.     .l index anchor
  893. } {2}
  894. test listbox-7.8 {DeleteEls procedure} {
  895.     .l delete 0 end
  896.     .l insert 0 a b c d e f g h i j
  897.     .l selection anchor 3
  898.     .l delete 4 5
  899.     .l index anchor
  900. } {3}
  901. test listbox-7.9 {DeleteEls procedure} {
  902.     .l delete 0 end
  903.     .l insert 0 a b c d e f g h i j
  904.     .l yview 3
  905.     update
  906.     .l delete 1 2
  907.     .l index @0,0
  908. } {1}
  909. test listbox-7.10 {DeleteEls procedure} {
  910.     .l delete 0 end
  911.     .l insert 0 a b c d e f g h i j
  912.     .l yview 3
  913.     update
  914.     .l delete 3 4
  915.     .l index @0,0
  916. } {3}
  917. test listbox-7.11 {DeleteEls procedure} {
  918.     .l delete 0 end
  919.     .l insert 0 a b c d e f g h i j
  920.     .l yview 3
  921.     update
  922.     .l delete 4 6
  923.     .l index @0,0
  924. } {3}
  925. test listbox-7.12 {DeleteEls procedure} {
  926.     .l delete 0 end
  927.     .l insert 0 a b c d e f g h i j
  928.     .l yview 3
  929.     update
  930.     .l delete 3 end
  931.     .l index @0,0
  932. } {1}
  933. test listbox-7.13 {DeleteEls procedure, updating view with partial last line} {
  934.     mkPartial
  935.     .partial.l yview 8
  936.     update
  937.     .partial.l delete 10 13
  938.     .partial.l index @0,0
  939. } {7}
  940. test listbox-7.14 {DeleteEls procedure} {
  941.     .l delete 0 end
  942.     .l insert 0 a b c d e f g h i j
  943.     .l activate 6
  944.     .l delete 3 4
  945.     .l index active
  946. } {4}
  947. test listbox-7.15 {DeleteEls procedure} {
  948.     .l delete 0 end
  949.     .l insert 0 a b c d e f g h i j
  950.     .l activate 6
  951.     .l delete 5 7
  952.     .l index active
  953. } {5}
  954. test listbox-7.16 {DeleteEls procedure} {
  955.     .l delete 0 end
  956.     .l insert 0 a b c d e f g h i j
  957.     .l activate 6
  958.     .l delete 5 end
  959.     .l index active
  960. } {4}
  961. test listbox-7.17 {DeleteEls procedure} {
  962.     .l delete 0 end
  963.     .l insert 0 a b c d e f g h i j
  964.     .l activate 6
  965.     .l delete 0 end
  966.     .l index active
  967. } {0}
  968. test listbox-7.18 {DeleteEls procedure} {
  969.     .l delete 0 end
  970.     .l insert 0 a b c "two words" d e f g h i j
  971.     update
  972.     set log {}
  973.     .l delete 4 6
  974.     update
  975.     set log
  976. } {{y 0 0.25}}
  977. test listbox-7.19 {DeleteEls procedure} {
  978.     .l delete 0 end
  979.     .l insert 0 a b c "two words" d e f g h i j
  980.     update
  981.     set log {}
  982.     .l delete 3
  983.     update
  984.     set log
  985. } {{y 0 0.2} {x 0 1}}
  986. if $doNonPortableTests {
  987.     # This test is non-portable due to variations in font sizes.
  988.  
  989.     test listbox-7.20 {DeleteEls procedure} {
  990.     catch {destroy .l2}
  991.     listbox .l2 -width 0 -height 0
  992.     pack .l2 -side top
  993.     .l2 insert 0 a b "two words" c d e f g
  994.     set x {}
  995.     lappend x [winfo reqwidth .l2] [winfo reqheight .l2]
  996.     .l2 delete 2 4
  997.     lappend x [winfo reqwidth .l2] [winfo reqheight .l2]
  998.     } {73 152 17 98}
  999. }
  1000. catch {destroy .l2}
  1001.  
  1002. if $doNonPortableTests {
  1003.     # This test is non-portable due to variations in font sizes.
  1004.  
  1005.     test listbox-8.1 {ListboxEventProc procedure} {
  1006.     catch {destroy .l}
  1007.     listbox .l -setgrid 1
  1008.     pack .l
  1009.     update
  1010.     set x [getsize .]
  1011.     destroy .l
  1012.     list $x [getsize .] [winfo exists .l] [info command .l]
  1013.     } {20x10 150x188 0 {}}
  1014. }
  1015. resetGridInfo
  1016. if $doNonPortableTests {
  1017.     test listbox-8.2 {ListboxEventProc procedure} {
  1018.     catch {destroy .l}
  1019.     listbox .l -height 5 -width 10
  1020.     .l insert 0 a b c "A string that is very very long" d e f g h i j k
  1021.     pack .l
  1022.     update
  1023.     place .l -width 50 -height 80
  1024.     update
  1025.     list [.l xview] [.l yview]
  1026.     } {{0 0.238095} {0 0.333333}}
  1027. }
  1028. test button-8.3 {ListboxEventProc procedure} {
  1029.     eval destroy [winfo children .]
  1030.     listbox .l1 -bg #543210
  1031.     rename .l1 .l2
  1032.     set x {}
  1033.     lappend x [winfo children .]
  1034.     lappend x [.l2 cget -bg]
  1035.     destroy .l1
  1036.     lappend x [info command .l*] [winfo children .]
  1037. } {.l1 #543210 {} {}}
  1038.  
  1039. test button-9.1 {ListboxCmdDeletedProc procedure} {
  1040.     eval destroy [winfo children .]
  1041.     listbox .l1
  1042.     rename .l1 {}
  1043.     list [info command .l*] [winfo children .]
  1044. } {{} {}}
  1045.  
  1046. catch {destroy .l}
  1047. listbox .l
  1048. pack .l
  1049. .l delete 0 end
  1050. .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11
  1051. test listbox-10.1 {GetListboxIndex procedure} {
  1052.     .l activate 3
  1053.     list [.l activate 3; .l index active] [.l activate 6; .l index active]
  1054. } {3 6}
  1055. test listbox-10.2 {GetListboxIndex procedure} {
  1056.     .l selection anchor 2
  1057.     .l index anchor
  1058. } 2
  1059. test listbox-10.3 {GetListboxIndex procedure} {
  1060.     .l insert end A B C D E
  1061.     .l selection anchor end
  1062.     .l delete 12 end
  1063.     list [.l index anchor] [.l index end]
  1064. } {12 12}
  1065. test listbox-10.4 {GetListboxIndex procedure} {
  1066.     list [catch {.l index a} msg] $msg
  1067. } {1 {bad listbox index "a":  must be active, anchor, end, @x,y, or a number}}
  1068. test listbox-10.5 {GetListboxIndex procedure} {
  1069.     .l index end
  1070. } {12}
  1071. test listbox-10.6 {GetListboxIndex procedure} {
  1072.     .l get end
  1073. } {el11}
  1074. test listbox-10.7 {GetListboxIndex procedure} {
  1075.     .l delete 0 end
  1076.     .l index end
  1077. } 0
  1078. .l delete 0 end
  1079. .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11
  1080. update
  1081. test listbox-10.8 {GetListboxIndex procedure} {
  1082.     list [catch {.l index @} msg] $msg
  1083. } {1 {bad listbox index "@":  must be active, anchor, end, @x,y, or a number}}
  1084. test listbox-10.9 {GetListboxIndex procedure} {
  1085.     list [catch {.l index @foo} msg] $msg
  1086. } {1 {bad listbox index "@foo":  must be active, anchor, end, @x,y, or a number}}
  1087. test listbox-10.10 {GetListboxIndex procedure} {
  1088.     list [catch {.l index @1x3} msg] $msg
  1089. } {1 {bad listbox index "@1x3":  must be active, anchor, end, @x,y, or a number}}
  1090. test listbox-10.11 {GetListboxIndex procedure} {
  1091.     list [catch {.l index @1,} msg] $msg
  1092. } {1 {bad listbox index "@1,":  must be active, anchor, end, @x,y, or a number}}
  1093. test listbox-10.12 {GetListboxIndex procedure} {
  1094.     list [catch {.l index @1,foo} msg] $msg
  1095. } {1 {bad listbox index "@1,foo":  must be active, anchor, end, @x,y, or a number}}
  1096. test listbox-10.13 {GetListboxIndex procedure} {
  1097.     list [catch {.l index @1,2x} msg] $msg
  1098. } {1 {bad listbox index "@1,2x":  must be active, anchor, end, @x,y, or a number}}
  1099. if $doNonPortableTests {
  1100.     test listbox-10.14 {GetListboxIndex procedure} {
  1101.     list [.l index @5,57] [.l index @5,58]
  1102.     } {2 3}
  1103. }
  1104. test listbox-10.15 {GetListboxIndex procedure} {
  1105.     list [catch {.l index 1xy} msg] $msg
  1106. } {1 {bad listbox index "1xy":  must be active, anchor, end, @x,y, or a number}}
  1107. test listbox-10.16 {GetListboxIndex procedure} {
  1108.     .l index 3
  1109. } {3}
  1110. test listbox-10.17 {GetListboxIndex procedure} {
  1111.     .l index 20
  1112. } {12}
  1113. test listbox-10.18 {GetListboxIndex procedure} {
  1114.     .l get 20
  1115. } {el11}
  1116. test listbox-10.19 {GetListboxIndex procedure} {
  1117.     .l index -2
  1118. } 0
  1119. test listbox-10.20 {GetListboxIndex procedure} {
  1120.     .l delete 0 end
  1121.     .l index 1
  1122. } 0
  1123.  
  1124. test listbox-11.1 {ChangeListboxView procedure} {
  1125.     catch {destroy .l}
  1126.     listbox .l -height 5 -yscrollcommand "record y"
  1127.     pack .l
  1128.     .l insert 0 a b c d e f g h i j
  1129.     update
  1130.     set log {}
  1131.     .l yview 2
  1132.     update
  1133.     list [.l yview] $log
  1134. }  {{0.2 0.7} {{y 0.2 0.7}}}
  1135. test listbox-11.2 {ChangeListboxView procedure} {
  1136.     catch {destroy .l}
  1137.     listbox .l -height 5 -yscrollcommand "record y"
  1138.     pack .l
  1139.     .l insert 0 a b c d e f g h i j
  1140.     update
  1141.     set log {}
  1142.     .l yview 8
  1143.     update
  1144.     list [.l yview] $log
  1145. }  {{0.5 1} {{y 0.5 1}}}
  1146. test listbox-11.3 {ChangeListboxView procedure} {
  1147.     catch {destroy .l}
  1148.     listbox .l -height 5 -yscrollcommand "record y"
  1149.     pack .l
  1150.     .l insert 0 a b c d e f g h i j
  1151.     .l yview 3
  1152.     update
  1153.     set log {}
  1154.     .l yview 3
  1155.     update
  1156.     list [.l yview] $log
  1157. }  {{0.3 0.8} {}}
  1158. test listbox-11.4 {ChangeListboxView procedure, partial last line} {
  1159.     mkPartial
  1160.     .partial.l yview 13
  1161.     .partial.l index @0,0
  1162. } {11}
  1163.  
  1164. catch {destroy .l}
  1165. listbox .l -font $fixed -xscrollcommand "record x" -width 10
  1166. .l insert 0 0123456789a123456789b123456789c123456789d123456789e123456789f123456789g123456789h123456789i123456789
  1167. pack .l
  1168. update
  1169. test listbox-12.1 {ChangeListboxOffset procedure} {
  1170.     set log {}
  1171.     .l xview 99
  1172.     update
  1173.     list [.l xview] $log
  1174. } {{0.912607 1} {{x 0.912607 1}}}
  1175. test listbox-12.2 {ChangeListboxOffset procedure} {
  1176.     set log {}
  1177.     .l xview moveto -.25
  1178.     update
  1179.     list [.l xview] $log
  1180. } {{0 0.100287} {{x 0 0.100287}}}
  1181. test listbox-12.3 {ChangeListboxOffset procedure} {
  1182.     .l xview 10
  1183.     update
  1184.     set log {}
  1185.     .l xview 10
  1186.     update
  1187.     list [.l xview] $log
  1188. } {{0.100287 0.200573} {}}
  1189.  
  1190. catch {destroy .l}
  1191. listbox .l -font $fixed -width 10 -height 5
  1192. pack .l
  1193. .l insert 0 a bb c d e f g h i j k l m n o p q r s
  1194. .l insert 0 0123456789a123456789b123456789c123456789d123456789
  1195. update
  1196. set width [expr [lindex [.l bbox 2] 2] - [lindex [.l bbox 1] 2]]
  1197. set height [expr [lindex [.l bbox 2] 1] - [lindex [.l bbox 1] 1]]
  1198. test listbox-13.1 {ListboxScanTo procedure} {
  1199.     .l yview 0
  1200.     .l xview 0
  1201.     .l scan mark 10 20
  1202.     .l scan dragto [expr 10-$width] [expr 20-$height]
  1203.     update
  1204.     list [.l xview] [.l yview]
  1205. } {{0.201149 0.402299} {0.5 0.75}}
  1206. test listbox-13.2 {ListboxScanTo procedure} {
  1207.     .l yview 5
  1208.     .l xview 10
  1209.     .l scan mark 10 20
  1210.     .l scan dragto 20 40
  1211.     update
  1212.     set x [list [.l xview] [.l yview]]
  1213.     .l scan dragto [expr 20-$width] [expr 40-$height]
  1214.     update
  1215.     lappend x [.l xview] [.l yview]
  1216. } {{0 0.201149} {0 0.25} {0.201149 0.402299} {0.5 0.75}}
  1217. test listbox-13.3 {ListboxScanTo procedure} {
  1218.     .l yview moveto 1.0
  1219.     .l xview moveto 1.0
  1220.     .l scan mark 10 20
  1221.     .l scan dragto 5 10
  1222.     update
  1223.     set x [list [.l xview] [.l yview]]
  1224.     .l scan dragto [expr 5+$width] [expr 10+$height]
  1225.     update
  1226.     lappend x [.l xview] [.l yview]
  1227. } {{0.824713 1} {0.75 1} {0.623563 0.824713} {0.25 0.5}}
  1228.  
  1229. test listbox-14.1 {NearestListboxElement procedure, partial last line} {
  1230.     mkPartial
  1231.     .partial.l nearest [winfo height .partial.l]
  1232. } {4}
  1233. if $doNonPortableTests {
  1234.     # These tests are non-portable due to variations in font sizes.
  1235.     catch {destroy .l}
  1236.     listbox .l -font $fixed -width 20 -height 10
  1237.     .l insert 0 a b c d e f g h i j k l m n o p q r s t
  1238.     .l yview 4
  1239.     pack .l
  1240.     update
  1241.     test listbox-14.2 {NearestListboxElement procedure} {
  1242.     .l index @50,0
  1243.     } {4}
  1244.     test listbox-14.3 {NearestListboxElement procedure} {
  1245.     list [.l index @50,35] [.l index @50,36]
  1246.     } {5 6}
  1247.     test listbox-14.4 {NearestListboxElement procedure} {
  1248.     .l index @50,200
  1249.     } {13}
  1250. }
  1251.  
  1252. test listbox-15.1 {ListboxSelect procedure} {
  1253.     .l delete 0 end
  1254.     .l insert 0 a b c d e f g h i j k l m n o p
  1255.     .l select set 2 4
  1256.     .l select set 7 12
  1257.     .l select clear 4 7
  1258.     .l curselection
  1259. } {2 3 8 9 10 11 12}
  1260. test listbox-15.2 {ListboxSelect procedure} {
  1261.     .l delete 0 end
  1262.     .l insert 0 a b c d e f g h i j k l m n o p
  1263.     catch {destroy .e}
  1264.     entry .e
  1265.     .e insert 0 "This is some text"
  1266.     .e select from 0
  1267.     .e select to 7
  1268.     .l selection clear 2 4
  1269.     set x [selection own]
  1270.     .l selection set 3
  1271.     list $x [selection own] [selection get]
  1272. } {.e .l d}
  1273. test listbox-15.3 {ListboxSelect procedure} {
  1274.     .l delete 0 end
  1275.     .l selection clear 0 end
  1276.     .l select set 0 end
  1277.     .l curselection
  1278. } {}
  1279.  
  1280. test listbox-16.1 {ListboxFetchSelection procedure} {
  1281.     .l delete 0 end
  1282.     .l insert 0 a b c "two words" e f g h i \\ k l m n o p
  1283.     .l selection set 2 4
  1284.     .l selection set 9
  1285.     .l selection set 11 12
  1286.     selection get
  1287. } "c\ntwo words\ne\n\\\nl\nm"
  1288. test listbox-16.2 {ListboxFetchSelection procedure} {
  1289.     .l delete 0 end
  1290.     .l insert 0 a b c "two words" e f g h i \\ k l m n o p
  1291.     .l selection set 3
  1292.     selection get
  1293. } "two words"
  1294. test listbox-16.3 {ListboxFetchSelection procedure, retrieve in several parts} {
  1295.     set long "This is quite a long string\n"
  1296.     append long $long $long $long $long
  1297.     append long $long $long $long $long
  1298.     append long $long $long
  1299.     .l delete 0 end
  1300.     .l insert 0 1$long 2$long 3$long 4$long 5$long
  1301.     .l selection set 0 end
  1302.     set sel [selection get]
  1303.     string compare 1$long\n2$long\n3$long\n4$long\n5$long $sel
  1304. } {0}
  1305. catch {unset long sel}
  1306.  
  1307. test listbox-17.1 {ListboxLostSelection procedure} {
  1308.     .l delete 0 end
  1309.     .l insert 0 a b c d e
  1310.     .l select set 0 end
  1311.     catch {destroy .e}
  1312.     entry .e
  1313.     .e insert 0 "This is some text"
  1314.     .e select from 0
  1315.     .e select to 5
  1316.     .l curselection
  1317. } {}
  1318. test listbox-17.2 {ListboxLostSelection procedure} {
  1319.     .l delete 0 end
  1320.     .l insert 0 a b c d e
  1321.     .l select set 0 end
  1322.     .l configure -exportselection 0
  1323.     catch {destroy .e}
  1324.     entry .e
  1325.     .e insert 0 "This is some text"
  1326.     .e select from 0
  1327.     .e select to 5
  1328.     .l curselection
  1329. } {0 1 2 3 4}
  1330.  
  1331. catch {destroy .l}
  1332. listbox .l -font $fixed -width 10 -height 5
  1333. pack .l
  1334. update
  1335. test listbox-18.1 {ListboxUpdateVScrollbar procedure} {
  1336.     .l configure -yscrollcommand "record y"
  1337.     set log {}
  1338.     .l insert 0 a b c
  1339.     update
  1340.     .l insert end d e f g h
  1341.     update
  1342.     .l delete 0 end
  1343.     update
  1344.     set log
  1345. } {{y 0 1} {y 0 0.625} {y 0 1}}
  1346. test listbox-18.2 {ListboxUpdateVScrollbar procedure, partial last line} {
  1347.     mkPartial
  1348.     .partial.l configure -yscrollcommand "record y"
  1349.     set log {}
  1350.     .partial.l yview 3
  1351.     update
  1352.     set log
  1353. } {{y 0.2 0.466667}}
  1354. test listbox-18.3 {ListboxUpdateVScrollbar procedure} {
  1355.     proc tkerror args {
  1356.     global x errorInfo
  1357.     set x [list $args $errorInfo]
  1358.     }
  1359.     .l configure -yscrollcommand gorp
  1360.     .l insert 0 foo
  1361.     update
  1362.     set x
  1363. } {{{invalid command name "gorp"}} {invalid command name "gorp"
  1364.     while executing
  1365. "gorp 0 1"
  1366.     (vertical scrolling command executed by listbox)}}
  1367. rename tkerror {}
  1368.  
  1369. catch {destroy .l}
  1370. listbox .l -font $fixed -width 10 -height 5
  1371. pack .l
  1372. update
  1373. test listbox-19.1 {ListboxUpdateVScrollbar procedure} {
  1374.     .l configure -xscrollcommand "record x"
  1375.     set log {}
  1376.     .l insert 0 abc
  1377.     update
  1378.     .l insert 0 "This is a much longer string..."
  1379.     update
  1380.     .l delete 0 end
  1381.     update
  1382.     set log
  1383. } {{x 0 1} {x 0 0.328638} {x 0 1}}
  1384. test listbox-19.2 {ListboxUpdateVScrollbar procedure} {
  1385.     proc tkerror args {
  1386.     global x errorInfo
  1387.     set x [list $args $errorInfo]
  1388.     }
  1389.     .l configure -xscrollcommand bogus
  1390.     .l insert 0 foo
  1391.     update
  1392.     set x
  1393. } {{{invalid command name "bogus"}} {invalid command name "bogus"
  1394.     while executing
  1395. "bogus 0 1"
  1396.     (horizontal scrolling command executed by listbox)}}
  1397.  
  1398. resetGridInfo
  1399. catch {destroy .l2}
  1400. catch {destroy .t}
  1401. catch {destroy .e}
  1402. catch {destroy .partial}
  1403. concat {}
  1404.